perm filename MARKER.SAI[1,BGB] blob sn#001253 filedate 1972-10-22 generic text, type T, neo UTF8
00100	ENTRY MARKER,SHOWFE;
00200	BEGIN	"MARKER"
00300		REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00400		REQUIRE "DDSUBR.HDR[DD,BGB]" SOURCE_FILE;
00500		REQUIRE "ARRAYS.HDR[SYS,BGB]" SOURCE_FILE;
00600		REQUIRE "COMMON[IA,BGB]" SOURCE_FILE;
00700		REQUIRE "DDCALL.HDR[DD,BGB]" SOURCE_FILE;
     

00100	α MAIL SUBROUTINE LINKAGE TO CORRELATOR;
00200		INTEGER MYJOB#,SUBJOBNAME,LTRPTR;
00300		SAFE INTEGER ARRAY LETTER[0:31];
00400		DEFINE	MAIL	=	"'710000000000";
00500	
00600	PROCEDURE CORELRUN;
00700	BEGIN	"CORELRUN"
00800		STRING STR; INTEGER LINE;
00900		START_CODE	MOVE SUBJOBNAME;'047000400043;SKIPA;POPJ '17,;END;
01000		LINE	←	PTYGET;
01100		PTOSTR(LINE,"L"&↓);STR←PTYSTR(LINE,"L");STR←PTYSTR(LINE,"#");
01200		PTOSTR(LINE,"COR/BGB"&↓);
01300		STR←PTYSTR(LINE,"B");STR←PTYSTR(LINE,"B");STR←PTYSTR(LINE,".");
01400		PTOSTR(LINE,"RU COREL"&↓);CALL(2,"SLEEP");STR←PTYSTR(LINE,"*");
01500	END	"CORELRUN";
01600	
01700	PROCEDURE CORELCALL;
01800	START_CODE	"CORELCALL"
01900		LABEL L1,L2;
02000		SKIPE	1,MYJOB#;
02100		JRST	L1;
02200	α INITIALIZATION;
02300		'047040000030;
02400		MOVEM	1,MYJOB#;
02500		MOVE	['435762455400];
02600		MOVEM	SUBJOBNAME;
02700		'047000400043;
02800		PUSHJ	'17,CORELRUN;
02900		MOVE	LETTER;
03000		HRRZM	LTRPTR;
03100		HRRM	L2;
03200		MOVE	1,MYJOB#;
03300	α SEND A COMMAND AND ARGUMENTS LETTER;
03400	L1:	MOVEM	1,@LTRPTR;
03500		MAIL	SUBJOBNAME;
03600		JRST 4,;
03700	α WAIT FOR THE RESULTS LETTER;
03800	L2:	MAIL	1,
03900	END	"CORELCALL";
     

00100	INTERNAL PROCEDURE MARKER;
00200	BEGIN	"MARKER"
00300		INTEGER ARRAY ITEMVAR FWN;
00400		STRING STR;
00500		INTEGER FLG,X,Y,MAGNIF,CYC;
00600		SHORT REAL MX,MY,MR,MDX,MDY;
00700		SHORT REAL ARRAY ∂F[1:5],∂FWN[1:5];
00800		SHORT REAL ARRAY ITEMVAR F;
00900	
01000	
01100	PROCEDURE RETICLE;
01200	BEGIN	"RETICLE"
01300		GETBI;
01400		IF CYC LAND 1 THEN
01500	BEGIN	"RECTANGLE"
01600		AI(MX-MDX,MY-MDY);
01700		AV(MX+MDX,MY-MDY);
01800		AV(MX+MDX,MY+MDY);
01900		AV(MX-MDX,MY+MDY);
02000		AV(MX-MDX,MY-MDY);
02100	END	"RECTANGLE";
02200		DOT(MX,MY);		α CROSS HAIRS;
02300		AI(MX+2,MY);
02400		AV(MX+4,MY);
02500		AI(MX-2,MY);
02600		AV(MX-4,MY);
02700		AI(MX,MY+2);
02800		AV(MX,MY+4);
02900		AI(MX,MY-2);
03000		AV(MX,MY-4);
03100		IF CYC LAND 2 THEN
03200	BEGIN	"CIRCLE"
03300		AI(MX,MY);
03400		ARC(MR,2*π,0);
03500	END	"CIRCLE";
03600		GETDD;
03700		PLOWIN;
03800		RELARY(BIBUF);
03900		SETCHN(1);
04000		ERASDD(1);
04100		SHOWDD;
04200		RELARY(DDBUF);
04300	END	"RETICLE";
     

00100	PROCEDURE AUTOCORRELATION;
00200	BEGIN	"ACOREL"
00300		INTEGER FLG,DM,DN,TIME1,TIME2,NCNT,SIZ3;
00350		REAL RMAX,MAXRAD,AVGRAD,THRESH;
00400		TVSEG.(CVIS(TVFILE,FLG),1);	α GET PROBE SEGMENT OFF DRUM;
00500		LETTER[1]←LETTER[2]←LETTER[3]←0;
00600	α PROBE WINDOW;
00700		LETTER[4]←	107 - (MY+MDY-1);
00800		LETTER[5]←	144 + (MX-MDX);
00900		LETTER[6]←	2*MDY;
01000		LETTER[7]←	2*MDX;
01100	α TARGET WINDOW;
01200		LETTER[8]←	107 - (∂(SWINDO)[2]+∂(SWINDO)[4]-1);
01300		LETTER[9]←	144 + (∂(SWINDO)[1]-∂(SWINDO)[3]);
01400		LETTER[10]←	2*∂(SWINDO)[4];
01500		LETTER[11]←	2*∂(SWINDO)[3];
01501	α SIZE OF RESULTS;
01502		DM	←	LETTER[10] - LETTER[6];
01503		DN	←	LETTER[11] - LETTER[7];
01504		SIZ3	←	(DM+1)*(DN+1);
01600	α THRESHOLD;
01700		OPEN(2,"TTY",0,1,0,30,0,0);
01800		OUTSTR(↓&9&"THRESHOLD = ");
01900		THRESH	←	REALIN(2);
02000		RELEASE(2);
02100	QUICK_CODE
02200		MOVE	11,LETTER;
02300		MOVE	12,THRESH;
02400		MOVEM	12,12(11);
02500	END;
02600		CORELCALL;
02700	START_CODE
02800		MOVE	1,LETTER;
02900		MOVE	15(1);	MOVEM RMAX;
03000		MOVE	16(1);	MOVEM NCNT;
03100		MOVE	17(1);	MOVEM MAXRAD;
03200		MOVE	18(1);	MOVEM AVGRAD;
03300		MOVE	19(1);	MOVEM TIME1;
03400		MOVE	20(1);	MOVEM TIME2;
03500	END;
03700		OUTSTR(9&CVS(NCNT*100%SIZ3)&"% ABOVE THRESHOLD.");
03701		OUTSTR(9&"NCNT = "&CVS(NCNT)&↓);
03800		OUTSTR(9&"MAXRAD = "&CVG(MAXRAD)&9);
03900		OUTSTR("AVGRAD = "&CVG(AVGRAD)&↓);
04200		SETFORMAT(0,3);
04300	OUTSTR(9&"RUN  TIME "&CVS(TIME1%60000)&":"&CVF((TIME1 MOD 60000)/1000)&↓);
04400	OUTSTR(9&"REAL TIME "&CVS(TIME2%60000)&":"&CVF((TIME2 MOD 60000)/1000)&↓);
04500	OUTSTR(9&"TIME SHARE"&9&CVS(100*TIME1/TIME2)&" %"&↓);
04600		SETFORMAT(0,7);
04700	END	"ACOREL";
     

00100	α INIT THE DDSUBR AND BIBUF;
00200		WNFRAM(216,288,0,0,480,512);
00300		WNCLIP(∂(SWINDO),∂(OWINDO),∂(OWINDO)[3]);
00400	α OBTAIN INITIAL RETICLE FROM THE SOURCE WINDOW;
00500		MX	←	∂(SWINDO)[1];
00600		MY	←	∂(SWINDO)[2];
00700		MDX	←	∂(SWINDO)[3]/2;
00800		MDY	←	∂(SWINDO)[4]/2;
00900		MR	←	∂(SWINDO)[3]/4;
01000	α POSITION THE RETICLE;
01100	BEGIN	"POSITION"
01200		INTEGER CHR,CTRL;
01300		SHORT REAL DEL;
01400		DEL	←	1.0;
01500		CYC	←	0;
01600		WHILE TRUE DO
01700	BEGIN
01800		LABEL L1,L2;
01900		RETICLE;
02000	L1:	CHR	←	INCHRW;
02100		CTRL	←	CHR LAND '200;
02200		CHR	←	CHR LAND '177;
02300		IF CHR="/" THEN DEL←DEL/2 ELSE
02400		IF CHR="\" THEN DEL←DEL*2 ELSE
02500		IF CHR="A" THEN AUTOCORRELATION ELSE
02600		IF CHR=13  THEN OUTSTR(".") ELSE GO L2;GO L1;L2:
02700		IF CTRL    THEN
02800				IF CHR=";" THEN MDX←MDX-DEL ELSE
02900				IF CHR=":" THEN MDX←MDX+DEL ELSE
03000				IF CHR="(" THEN MDY←MDY-DEL ELSE
03100				IF CHR=")" THEN MDY←MDY+DEL ELSE GO L1
03200			ELSE
03300		IF CHR="." THEN CYC←CYC+1 ELSE
03400		IF CHR=";" THEN MX←MX-DEL ELSE
03500		IF CHR=":" THEN MX←MX+DEL ELSE
03600		IF CHR="(" THEN MY←MY-DEL ELSE
03700		IF CHR=")" THEN MY←MY+DEL ELSE
03800		IF CHR="-" THEN MR←ABS(MR-DEL) ELSE
03900		IF CHR="*" THEN MR←MR+DEL ELSE
04000		IF CHR='175 THEN DONE ELSE GO L1;
04100	END;
04200	END	"POSITION";
04300	
04400	α STASH THE POSITION INTO THE FEATURE WINDOW DATUM;
04500		∂FWN[1]←MX;
04600		∂FWN[2]←MY;
04700		∂FWN[3]←MDX;
04800		∂FWN[4]←MDY;
04900		∂FWN[5]←MR;
     

00100	α NAME THAT FEATURE;
00200		OUTSTR(↓&9&"NAME = ");
00300		STR	←	INCHWL;
00400		IF "A"≤STR ∧ STR≤"Z" THEN ELSE RETURN;
00500		F	←	CVSI(STR,FLG);
00600	α NEW FEATURE CREATION;
00700		IF FLG THEN BEGIN F←NEW(∂F);NEW_PNAME(F,STR);PUT F IN FEASET;END;
00800	α UPDATE FEATURE WINDOW IF IT EXISTS;
00900		FLG	←	TRUE;
01000		∀ FWN|TVFILE⊗F≡FWN DO
01100		BEGIN	ARRBLT(∂(FWN)[1],∂FWN[1],5);FLG←FALSE;END;
01200	α NEW FEATURE WINDOW CREATION;
01300		IF FLG THEN
01400		BEGIN FWN←NEW(∂FWN);MAKE TVFILE⊗F≡FWN;END;
01500	α PLACE FEATURE LABEL IN DD IMAGE;
01600		AI(MX+2,MY+(4/(1 LSH ∂(OWINDO)[3])));
01700		DDSTR(1,STR);
01800		OUTSTR(↓&"*");
01900	END	"MARKER";
     

00100	α SHOW THE ACTUAL AND PROJECTED RASTER POSITIONS OF A FEATURE;
00200	INTERNAL PROCEDURE SHOWFE (BOOLEAN Q);
00300	BEGIN	"SHOWFE"
00400		DEFINE THRICE="FOR I←1 STEP 1 UNTIL 3 DO";
00500		INTEGER I,FLG;
00600		REAL MX,MY;
00700		REAL ARRAY U,W[1:3],C[1:4,1:3];
00800		REAL ARRAY ITEMVAR FWN;
00900		REAL ARRAY ITEMVAR F;
01000		STRING STR;
01100	α GET THE CAMERA DATUM IF NECESSARY AND POSSIBLE;
01200		IF Q THEN
01300	BEGIN	"GETCAM"
01400		REAL ARRAY ITEMVAR CAM;
01500		SET CAMS;
01600		CAMS	←	LOCOR⊗TVFILE;
01700		IF LENGTH(CAMS)=0 THEN 
01800	BEGIN
01900		Q←FALSE;
02000		OUTSTR("CAMERA NOT FOUND."&↓);
02100	END	ELSE
02200	BEGIN
02300		CAM	←	LOP(CAMS);
02400		ARRBLT(C[1,1],∂(CAM)[1,1],12);
02500	END;
02600	END	"GETCAM";
02700		OUTSTR(↓);
02800		WNFRAM(216,288,0,0,480,512);
02900		WNCLIP(∂(SWINDO),∂(OWINDO),∂(OWINDO)[3]);
03000	α STROBE THE USER FOR A FEATURE NAME;
03100	DO BEGIN OUTSTR(↓&9&"FEATURE = ");
03200		STR	←	INCHWL;
03300		F	←	CVSI(STR,FLG);
03400	END	UNTIL ¬FLG;
     

00100	α DISPLAY WHERE THE FEATURE IS SEEN WITH A DOT AND CROSS;
00200		GETBI;
00300		∀ FWN|TVFILE⊗F≡FWN DO
00400	BEGIN	"SEEN"
00500		REAL MX,MY;
00600		MX←∂(FWN)[1];
00700		MY←∂(FWN)[2];
00800		DOT(MX,MY);
00900		AI(MX+2,MY);	AV(MX+4,MY);
01000		AI(MX-2,MY);	AV(MX-4,MY);
01100		AI(MX,MY+2);	AV(MX,MY+4);
01200		AI(MX,MY-2);	AV(MX,MY-4);
01300		OUTSTR("FEATURE IS AT = "&CVG(MX)&9&CVG(MY)&↓);
01400	END	"SEEN";
     

00100	α DISPLAY WHERE THE FEATURE SHOULD BE WITH A DOT AND CRISS;
00200		IF Q THEN 
00300	BEGIN	"CRISS"
00400		THRICE U[I] ← ∂(F)[I] - C[4,I];
00500		THRICE W[I] ← C[I,1]*U[1] + C[I,2]*U[2] + C[I,3]*U[3];
00600		IF W[3]<-FOCAL THEN 
00700	BEGIN
00800		MX	←	SCALX*W[1]/W[3];
00900		MY	←	SCALY*W[2]/W[3];
01000		OUTSTR(" SHOULD BE AT = "&CVG(MX)&9&CVG(MY)&↓);
01100		DOT(MX,MY);
01200		AI(MX+2,MY+2);	AV(MX+4,MY+4);
01300		AI(MX-2,MY-2);	AV(MX-4,MY-4);
01400		AI(MX-2,MY+2);	AV(MX-4,MY+4);
01500		AI(MX+2,MY-2);	AV(MX+4,MY-4);
01600	END	ELSE OUTSTR("BEHIND CAMERA."&↓);
01700	END	"CRISS";
01800	α DATA DISC OUTPUT;
01900		GETDD;PLOWIN;RELARY(BIBUF);SETCHN(1);ERASDD(1);SHOWDD;
02000		RELARY(DDBUF);
02100		OUTSTR(↓&"*");
02200	END	"SHOWFE";
02300	END	"MARKER";